home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / 4utils80.zip / SCANARJF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  10KB  |  270 lines
  1. UNIT ScanARJFiles;
  2. {$V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.    (c) 1992, 1993 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.  
  26.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  27.  
  28.    This unit provides the extraction of file names in .ARJ files.
  29.    ----------------------------------------------------------------------- *)
  30.  
  31. INTERFACE USES Dos, Globals;
  32.  
  33. PROCEDURE SearchInARJFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  34.                           VAR Dir: PathStr; VAR arjsearch: SearchRec);
  35. PROCEDURE ShowCompARJFileData(VAR search,arjsearch: SearchRec;VAR Path: PathStr;
  36.                               csize: LONGINT);
  37.  
  38. VAR OldARJFileName: PathStr;
  39.  
  40. IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
  41.  
  42. CONST ARJMagicHeader = $EA60;
  43.  
  44. VAR ARJFile  : FILE;
  45.  
  46. PROCEDURE SearchInARJFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  47.                           VAR Dir: PathStr; VAR arjsearch: SearchRec);
  48.  
  49. VAR i          : WORD;
  50.     k, dummy   : BYTE;
  51.     ARJFileName: NameExtStr;
  52.     sig        : LONGINT;
  53.     hsize      : WORD;
  54.     flags      : BYTE;
  55.     c          : CHAR;
  56.  
  57. BEGIN (* SearchInARJFile *)
  58.  Assign(ARJFile,arjsearch.Name); Reset(ARJFile,1);
  59.  BlockRead(ARJFile,Buffer^,BufSize,BytesRead); BufPtr := 0; FilePtr := 0;
  60.  
  61.  sig := LONGINT(ReadByte) SHL  8 + LONGINT(ReadByte);
  62.  (* header id (main and local file) = 0xEA60 or 60000U *)
  63.  IF sig <> ARJMagicHeader THEN
  64.   BEGIN
  65.    WriteLn(output,'ARJ file error: magic file header signature missing!');
  66.    WriteLn(output);
  67.   END;
  68.  
  69.  hsize := 1;
  70.  REPEAT
  71.   (* header id (main and local file) = 0xEA60 or 60000U *)
  72.   REPEAT
  73.    REPEAT
  74.     sig := ReadByte;
  75.     IF BufPtr > BufSize THEN
  76.      BEGIN
  77.       BlockRead(ARJFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  78.      END;
  79.    UNTIL (sig = Lo(ARJMagicHeader)) OR (BufPtr > BytesRead);
  80.    REPEAT
  81.     sig := ReadByte;
  82.     IF BufPtr > BufSize THEN
  83.      BEGIN
  84.       BlockRead(ARJFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  85.      END;
  86.    UNTIL (sig = Hi(ARJMagicHeader)) OR (BufPtr > BytesRead);
  87.   UNTIL (sig = Hi(ARJMagicHeader)) OR (BufPtr > BytesRead);
  88.  
  89.   IF sig = Hi(ARJMagicHeader) THEN
  90.    BEGIN
  91.     hsize := LONGINT(ReadByte) SHL 8 + LONGINT(ReadByte);
  92.     (* 2   basic header size (from 'first_hdr_size' thru 'comment' below)
  93.        = first_hdr_size + strlen(filename) + 1 + strlen(comment) + 1
  94.        = 0 if end of archive *)
  95.     IF hsize > 0 THEN
  96.      BEGIN
  97.       FOR i := 1 TO 4 DO dummy := ReadByte;
  98.       (* 1   first_hdr_size (size up to and including 'extra data')
  99.          1   archiver version number
  100.          1   minimum archiver version to extract
  101.          1   host OS   (0 = MSDOS, 1 = PRIMOS, 2 = UNIX, 3 = AMIGA, 4 = MAC-OS)
  102.                (5 = OS/2, 6 = APPLE GS, 7 = ATARI ST, 8 = NEXT)
  103.                (9 = VAX VMS) *)
  104.       flags := ReadByte;
  105.       (* 1   arj flags (0x01 = GARBLED_FLAG) indicates passworded file
  106.                (0x02 = RESERVED)
  107.                (0x04 = VOLUME_FLAG)  indicates continued file to next
  108.                                              volume (file is split)
  109.                (0x08 = EXTFILE_FLAG) indicates file starting position
  110.                                              field (for split files)
  111.                        (0x10 = PATHSYM_FLAG) indicates filename translated
  112.                          ("\" changed to "/")
  113.                        (0x20 = BACKUP_FLAG)  indicates file marked as backup *)
  114.       FOR i := 1 TO 3 DO dummy := ReadByte;
  115.       (* 1   method    (0 = stored, 1 = compressed most ... 4 compressed fastest)
  116.          1   file type (0 = binary, 1 = 7-bit text)
  117.                (3 = directory, 4 = volume label)
  118.          1   reserved *)
  119.  
  120.       Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  121.       (* 4   date time modified *)
  122.       csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  123.       (* 4   compressed size *)
  124.       Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  125.       (* 4   original size (this will be different for text mode compression) *)
  126.  
  127.       FOR i := 1 TO 5 DO dummy := ReadByte;
  128.       (* 4   original file's CRC
  129.          2   filespec position in filename *)
  130.       Search.Attr := ReadByte; (* dummy := ReadByte; *)
  131.       (* 2   file access mode
  132.          2   host data (currently not used) *)
  133.       IF flags AND $08 <> $08 THEN
  134.        FOR i := 1 TO 4 DO dummy := ReadByte;
  135.       (* ?   extra data
  136.          4 bytes for extended file starting position when used
  137.          (this is present when EXTFILE_FLAG is set) *)
  138.  
  139.       WITH Search DO
  140.        BEGIN
  141.         name  := ''; c := 'x';
  142.         WHILE c <> #0 DO
  143.          BEGIN
  144.           c := Chr(ReadByte); name := name+DownCase(c);
  145.          END;
  146.         k := Length(Name); IF Name[k] = #0 THEN Delete(Name,k,1);
  147.        END;
  148.       (* ?   filename (null-terminated string) *)
  149.       (* ?   comment  (null-terminated string) ... *)
  150.  
  151.       FOR k := 1 TO FileSpecs DO
  152.        BEGIN
  153.         FSplit(FileSpec[k],Path,name,ext);
  154.         WHILE Length(name) < 8 DO name := name+' ';
  155.         IF Ext = '' THEN Ext := '.   '
  156.         ELSE
  157.          WHILE Length(ext) < 4 DO ext := ext+' ';
  158.  
  159.         i := Pos('*',name);
  160.         IF  i > 0 THEN
  161.          WHILE i <= 8 DO
  162.           BEGIN
  163.            name[i] := '?'; INC(i);
  164.           END;
  165.  
  166.         i := Pos('*',ext);
  167.         IF  i > 0 THEN
  168.          WHILE i <= 4 DO
  169.           BEGIN
  170.            ext[i] := '?'; INC(i);
  171.           END;
  172.         FileSpec[k] := Path+name+ext;
  173.  
  174.         FSplit(Search.Name,Path,name,ext);
  175.         WHILE Length(name) < 8 DO name := name +' ';
  176.         IF Ext = '' THEN Ext := '.   '
  177.         ELSE
  178.          WHILE Length(ext)      < 4 DO ext := ext+' ';
  179.         ARJFileName:= Path+name+ext;
  180.  
  181.         i := 1;
  182.         WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = ARJFileName[i])) AND
  183.                (i<12) DO
  184.          INC(i);
  185.  
  186.         IF ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  187.             (FileSpec[k][i] = '?') OR (FileSpec[k][i] = ARJFileName[i]) THEN
  188.          ShowCompARJFileData(search,arjsearch,Dir,csize);
  189.        END;
  190.  
  191.       INC(BufPtr,csize); INC(FilePtr,csize);
  192.       IF BufPtr > BufSize THEN
  193.        BEGIN
  194.         Seek(ARJFile,FilePtr);
  195.         BlockRead(ARJFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  196.        END;
  197.      END;
  198.    END;
  199.  UNTIL hsize = 0;
  200.  
  201.  Close(ARJFile);
  202. END; (* SearchInARJFile *)
  203.  
  204. PROCEDURE ShowCompARJFileData(VAR search,arjsearch: SearchRec;VAR Path: PathStr;
  205.                               csize: LONGINT);
  206.  
  207. BEGIN
  208.  IF BareOutput THEN
  209.   Write(Output,Path,arjsearch.Name,' ')
  210.  ELSE
  211.   BEGIN
  212.    IF FileCount = 0 THEN
  213.     BEGIN
  214.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  215.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  216.     END;
  217.  
  218.    IF arjsearch.Name <> OldARJFileName THEN
  219.     BEGIN
  220.      DownString(arjsearch.Name); OldARJFileName := arjsearch.Name;
  221.  
  222.      InfoArray[0] := LONGINT(@arjsearch.Name);
  223.  
  224.      SizeStr := FormattedLongIntStr(arjsearch.Size,8);
  225.      InfoArray[1] := LONGINT(@SizeStr);
  226.  
  227.      UnpackTime(arjsearch.Time,DateRec);
  228.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  229.      InfoArray[2] := LONGINT(@Date);
  230.      InfoArray[3] := LONGINT(@Time);
  231.  
  232.      AttrStr := '....';
  233.      IF arjSearch.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  234.      IF arjSearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  235.      IF arjSearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  236.      IF arjSearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'r';
  237.      InfoArray[4] := LONGINT(@AttrStr);
  238.  
  239.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  240.      WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  241.     END;
  242.  
  243.    InfoArray[0] := LONGINT(@search.Name);
  244.  
  245.    SizeStr := FormattedLongIntStr(search.Size,8);
  246.    InfoArray[1] := LONGINT(@SizeStr);
  247.  
  248.    UnpackTime(search.Time,DateRec);
  249.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  250.    InfoArray[2] := LONGINT(@Date);
  251.    InfoArray[3] := LONGINT(@Time);
  252.  
  253. (*   AttrStr := '----';
  254.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  255.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  256.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  257.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  258.                                           ELSE AttrStr[4] := 'w';
  259.    InfoArray[4] := LONGINT(@AttrStr);
  260.  
  261.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl+' %4s',InfoArray); *)
  262.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  263.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  264.  
  265.    INC(TotalSize,csize); INC(DirSize,csize);
  266.    INC(TotalFileCount);  INC(FileCount);
  267.   END;
  268. END; (* ShowFileData *)
  269.  
  270. END.